If we see a trend, the time series is not stationary (i.e. does not depend on the time of the observation).
\[ R_i = \frac{X_i - X_{i-7}}{X_{i-7}} * 100 \] \(R_i\) is the relative weekly change (increase or decrease) in percentage.
Examine the suitability for each time series \(R_i\) separately:
Explain your choice of threshold and briefly comment on the diagnostic plots for each model:
The selected threshold \(u\) is 125.
The selected threshold \(u\) is 35.
The selected threshold \(u\) is 100.
The selected threshold \(u\) is 30.
The selected threshold \(u\) is 25.
The selected threshold \(u\) is 200.
The selected threshold \(u\) is 50.
The selected threshold \(u\) is 700.
The selected threshold \(u\) is 100.
The selected threshold \(u\) is 100.
The selected threshold \(u\) is 70.
The selected threshold \(u\) is 60.
``
Suitability of POT: - Princess Margaret, United Kingdom, United States (?), Wiston Churchill do not seem to be suitable for POT because of the too few numbers of exceedances.
library(evd)
# data frame for the 99 quantile and measure of uncertainty for all the type
thresholds <- c(60, 70, 125, 200, 100, 700, 100, 50, 35, 100, 25, 30)
data99 <- data.frame(matrix(0, nrow = 2, ncol = length(unique(ts$type))))
colnames(data99) <- unique(ts$type)
rownames(data99) <- c("quantile99","uncertainty")
for (i in 1:ncol(data99)){
# filter for the type
ts_type <- ts %>%
filter(type == names(data99)[i])
# remove na
ts_type <- ts_type %>%
filter(!is.na(`daily count modified`))
# compute 99 quantile
quantile99 <- quantile(ts_type$`daily count modified` , 0.99)
# save the quantile in the data.frame
data99[1,i] <- quantile99
# measure of uncertainty
# not sure about the mper argument
# doc of the function here : https://www.rdocumentation.org/packages/evd/versions/2.3-3/topics/fpot
uncertainty <- fpot(ts_type$`daily count modified`, threshold = thresholds[i], mper = quantile99)
# not sure if we need to save the r level or shape
data99[2,i] <- uncertainty$std.err[1]
}
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
data99
## 2016_Summer_Olympics Diana,_Princess_of_Wales Elizabeth_II
## quantile99 143.5829 363.1843 642.9873
## uncertainty 179.0603 492.1521 1753.4239
## George_VI Prince_Philip,_Duke_of_Edinburgh
## quantile99 520.8474 1111.279
## uncertainty 10635.0359 1579.921
## Princess_Margaret,_Countess_of_Snowdon Queen_Victoria
## quantile99 973.8326 421.7058
## uncertainty 17545.2920 544.1161
## United_Kingdom United_States Winston_Churchill World_War_I
## quantile99 79.08561 62.24281 846.2276 94.64611
## uncertainty 1784.17935 266.51113 7139.2646 77.44259
## World_War_II
## quantile99 61.75727
## uncertainty 48.12695
for detecting simultaneous high load across the 12 series provided, Which pages seem to have simultaneous high load?
library(extRemes)
## Loading required package: Lmoments
## Loading required package: distillery
##
## Attaching package: 'extRemes'
## The following objects are masked from 'package:evd':
##
## fbvpot, mrlplot
## The following objects are masked from 'package:stats':
##
## qqnorm, qqplot
# idea for graphical representation : block maxima by week colored by type
# https://rdrr.io/cran/extRemes/man/blockmaxxer.html
tsnona <- ts%>% filter(!is.na(`daily count modified`))
# compute block maxima
bm <- blockmaxxer(tsnona, blocks = tsnona$date, which="daily count modified")
library(plotly)
c <-ggplot(tsnona, aes(x=date, y=`daily count modified`)) + geom_point(aes(color = type)) + geom_point(data=bm,aes(date,`daily count modified`, fill = type), colour = "lightpink1")
ggplotly(c)
# numerical method
# GDP model ?
#https://rdrr.io/cran/evir/man/gpd.html
library(evir)
##
## Attaching package: 'evir'
## The following object is masked from 'package:extRemes':
##
## decluster
## The following objects are masked from 'package:evd':
##
## dgev, dgpd, pgev, pgpd, qgev, qgpd, rgev, rgpd
## The following object is masked from 'package:ggplot2':
##
## qplot
modified_NoNA <- modified_ts %>% filter(!is.na(`daily count modified`))
gpd.model <- gpd(modified_NoNA$`daily count modified`, threshold = mean(thresholds))
gpd.plot <- tailplot(gpd.model)
#gpd.sf <- gpd.sfall(gpd.plot,0.99)
library(FRAPO)
## Loading required package: cccp
## Loading required package: Rglpk
## Loading required package: slam
## Using the GLPK callable library version 4.47
## Loading required package: timeSeries
## Loading required package: timeDate
## Financial Risk Modelling and Portfolio Optimisation with R (version 0.4-1)
modified_pivot <- modified_NoNA %>% pivot_wider(values_from =`daily count modified`, names_from = type,date)
tdc(modified_pivot[,-1], method = "EVT")
## 2016_Summer_Olympics
## 2016_Summer_Olympics 1.00000000
## Diana,_Princess_of_Wales 0.07142857
## Elizabeth_II 0.00000000
## George_VI 0.07142857
## Prince_Philip,_Duke_of_Edinburgh 0.03571429
## Princess_Margaret,_Countess_of_Snowdon 0.10714286
## Queen_Victoria 0.03571429
## United_Kingdom 0.10714286
## United_States 0.21428571
## Winston_Churchill 0.03571429
## World_War_I 0.00000000
## World_War_II 0.03571429
## Diana,_Princess_of_Wales Elizabeth_II
## 2016_Summer_Olympics 0.07142857 0.00000000
## Diana,_Princess_of_Wales 1.00000000 0.07142857
## Elizabeth_II 0.07142857 1.00000000
## George_VI 0.07142857 0.46428571
## Prince_Philip,_Duke_of_Edinburgh 0.14285714 0.60714286
## Princess_Margaret,_Countess_of_Snowdon 0.07142857 0.46428571
## Queen_Victoria 0.07142857 0.28571429
## United_Kingdom 0.03571429 0.10714286
## United_States 0.03571429 0.00000000
## Winston_Churchill 0.00000000 0.03571429
## World_War_I 0.00000000 0.14285714
## World_War_II 0.03571429 0.00000000
## George_VI
## 2016_Summer_Olympics 0.07142857
## Diana,_Princess_of_Wales 0.07142857
## Elizabeth_II 0.46428571
## George_VI 1.00000000
## Prince_Philip,_Duke_of_Edinburgh 0.53571429
## Princess_Margaret,_Countess_of_Snowdon 0.57142857
## Queen_Victoria 0.32142857
## United_Kingdom 0.07142857
## United_States 0.03571429
## Winston_Churchill 0.07142857
## World_War_I 0.10714286
## World_War_II 0.03571429
## Prince_Philip,_Duke_of_Edinburgh
## 2016_Summer_Olympics 0.03571429
## Diana,_Princess_of_Wales 0.14285714
## Elizabeth_II 0.60714286
## George_VI 0.53571429
## Prince_Philip,_Duke_of_Edinburgh 1.00000000
## Princess_Margaret,_Countess_of_Snowdon 0.53571429
## Queen_Victoria 0.21428571
## United_Kingdom 0.07142857
## United_States 0.00000000
## Winston_Churchill 0.03571429
## World_War_I 0.10714286
## World_War_II 0.03571429
## Princess_Margaret,_Countess_of_Snowdon
## 2016_Summer_Olympics 0.10714286
## Diana,_Princess_of_Wales 0.07142857
## Elizabeth_II 0.46428571
## George_VI 0.57142857
## Prince_Philip,_Duke_of_Edinburgh 0.53571429
## Princess_Margaret,_Countess_of_Snowdon 1.00000000
## Queen_Victoria 0.21428571
## United_Kingdom 0.07142857
## United_States 0.07142857
## Winston_Churchill 0.00000000
## World_War_I 0.10714286
## World_War_II 0.03571429
## Queen_Victoria United_Kingdom
## 2016_Summer_Olympics 0.03571429 0.10714286
## Diana,_Princess_of_Wales 0.07142857 0.03571429
## Elizabeth_II 0.28571429 0.10714286
## George_VI 0.32142857 0.07142857
## Prince_Philip,_Duke_of_Edinburgh 0.21428571 0.07142857
## Princess_Margaret,_Countess_of_Snowdon 0.21428571 0.07142857
## Queen_Victoria 1.00000000 0.03571429
## United_Kingdom 0.03571429 1.00000000
## United_States 0.00000000 0.03571429
## Winston_Churchill 0.00000000 0.17857143
## World_War_I 0.10714286 0.10714286
## World_War_II 0.00000000 0.10714286
## United_States Winston_Churchill
## 2016_Summer_Olympics 0.21428571 0.03571429
## Diana,_Princess_of_Wales 0.03571429 0.00000000
## Elizabeth_II 0.00000000 0.03571429
## George_VI 0.03571429 0.07142857
## Prince_Philip,_Duke_of_Edinburgh 0.00000000 0.03571429
## Princess_Margaret,_Countess_of_Snowdon 0.07142857 0.00000000
## Queen_Victoria 0.00000000 0.00000000
## United_Kingdom 0.03571429 0.17857143
## United_States 1.00000000 0.07142857
## Winston_Churchill 0.07142857 1.00000000
## World_War_I 0.17857143 0.10714286
## World_War_II 0.17857143 0.07142857
## World_War_I World_War_II
## 2016_Summer_Olympics 0.0000000 0.03571429
## Diana,_Princess_of_Wales 0.0000000 0.03571429
## Elizabeth_II 0.1428571 0.00000000
## George_VI 0.1071429 0.03571429
## Prince_Philip,_Duke_of_Edinburgh 0.1071429 0.03571429
## Princess_Margaret,_Countess_of_Snowdon 0.1071429 0.03571429
## Queen_Victoria 0.1071429 0.00000000
## United_Kingdom 0.1071429 0.10714286
## United_States 0.1785714 0.17857143
## Winston_Churchill 0.1071429 0.07142857
## World_War_I 1.0000000 0.42857143
## World_War_II 0.4285714 1.00000000